Take-home Exercise 4

1 The task

In this take-home exercise, you are required to uncover the impact of COVID-19 as well as the global economic and political dynamic in 2022 on Singapore bi-lateral trade (i.e. Import, Export and Trade Balance) by using appropriate analytical visualisation techniques learned in Lesson 6: It’s About Time. Students are encouraged to apply appropriate interactive techniques to enhance user and data discovery experiences.

The write-up of the take-home exercise should include but not limited to the followings:

• Describe the selection and designed consideration of the analytical data visualisation used. The discussion should limit to not more than 150 words each.
• A reproducible description of the procedures used to prepare the analytical visualisation. Please refer to the peer submission I shared.
• A write-up of not more than 100 words to discuss the patterns reveal by each analytical visualization prepared.

Packages

packages = c('readxl', 'datawizard', 'crosstalk', 'tidyr', 'lubridate','tidyverse', 'plotly', 'd3scatter')
for(p in packages){
  if(!require(p,character.only = T)){
    install.packages(p)
  }
  library(p,character.only = T)
}

2 Data

Merchandise Trade provided by Department of Statistics, Singapore (DOS) is used. The study period is between January 2020 to December 2022.

Checking the number of sheets it contains

excel_sheets("data/data.xlsx")

[1] "Content" "T1"      "T2"     

Importing data

In the code chunk below, read_xlsx() of readxl package is used to import the data worksheet of our data workbook into R.

T1 <- read_xlsx("data/data.xlsx", sheet = "T1")
T2 <- read_xlsx("data/data.xlsx", sheet = "T2")

Formatting data

# Transpose the fat table to long table
T1 <- gather(T1, "MonthYear", "ImportValue", -`Data Series`)
T2 <- gather(T2, "MonthYear", "ExportValue", -`Data Series`)

Note

ymd_hms() and hour() are from lubridate package

# Convert MonthYear column to date format
T1$`MonthYear` <- ym(T1$`MonthYear`)
T2$`MonthYear` <- ym(T2$`MonthYear`)

# Convert ImportValue column to numeric format
T1$`ImportValue` <- as.numeric(T1$`ImportValue`)
T2$`ExportValue` <- as.numeric(T2$`ExportValue`)

Code

# Separate region and country
Region <- T1 %>% 
  filter(grepl('Million', `Data Series`)) %>%
  rename("Region" = "ImportValue")

Country <- T1 %>% 
  filter(grepl('Thousand', `Data Series`)) %>%
  rename("Country" = "ImportValue")

Import <- full_join(Region, Country, by = join_by(`Data Series`, `MonthYear`))
Import  <- gather(Import , "Level", "ImportValue", -`Data Series`, -`MonthYear`)

Code

# Separate region and country
Region <- T2 %>% 
  filter(grepl('Million', `Data Series`)) %>%
  rename("Region" = "ExportValue")

Country <- T2 %>% 
  filter(grepl('Thousand', `Data Series`)) %>%
  rename("Country" = "ExportValue")

Export <- full_join(Region, Country, by = join_by(`Data Series`, `MonthYear`))
Export  <- gather(Export , "Level", "ExportValue", -`Data Series`, -`MonthYear`)

Filter date and rename column

Import <- Import %>%
  filter(`MonthYear`>= as.Date("2009-12-01")) %>% 
  rename(`Country` = `Data Series`)

Export <- Export %>%
  filter(`MonthYear`>= as.Date("2009-12-01")) %>%
  rename(`Country` = `Data Series`)

Merge Import and Export into one table

data1 <- full_join(Import, Export, by = join_by(`Country`, `MonthYear`,`Level`))

data  <- gather(data1 , "Type", "Value", -`Country`, -`MonthYear`,-`Level`)

2.1 Table: Merchandise Imports/Export By Region/Market, Monthly

Country	MonthYear	Level	ImportValue
America (Million Dollars)	2022-12-01	Region	6901.5
Asia (Million Dollars)	2022-12-01	Region	33611.7
Europe (Million Dollars)	2022-12-01	Region	7541.8
Oceania (Million Dollars)	2022-12-01	Region	1399.9
Africa (Million Dollars)	2022-12-01	Region	414.9
European Union (Million Dollars)	2022-12-01	Region	5058.8
America (Million Dollars)	2022-11-01	Region	7529.4
Asia (Million Dollars)	2022-11-01	Region	34733.7
Europe (Million Dollars)	2022-11-01	Region	7242.8
Oceania (Million Dollars)	2022-11-01	Region	664.4
Africa (Million Dollars)	2022-11-01	Region	483.6
European Union (Million Dollars)	2022-11-01	Region	4961.4
America (Million Dollars)	2022-10-01	Region	7666.4
Asia (Million Dollars)	2022-10-01	Region	36120.9
Europe (Million Dollars)	2022-10-01	Region	7475.9

Country	MonthYear	Level	ExportValue
America (Million Dollars)	2022-12-01	Region	6217.5
Asia (Million Dollars)	2022-12-01	Region	39734.8
Europe (Million Dollars)	2022-12-01	Region	4924.4
Oceania (Million Dollars)	2022-12-01	Region	3034.8
Africa (Million Dollars)	2022-12-01	Region	1088.6
European Union (Million Dollars)	2022-12-01	Region	4137.1
America (Million Dollars)	2022-11-01	Region	6394.2
Asia (Million Dollars)	2022-11-01	Region	37973.2
Europe (Million Dollars)	2022-11-01	Region	5025.2
Oceania (Million Dollars)	2022-11-01	Region	3243.1
Africa (Million Dollars)	2022-11-01	Region	1527.0
European Union (Million Dollars)	2022-11-01	Region	4243.4
America (Million Dollars)	2022-10-01	Region	6653.9
Asia (Million Dollars)	2022-10-01	Region	40500.8
Europe (Million Dollars)	2022-10-01	Region	5121.5

2.2 Scatter plot Dashboard

Code

library(plotly)

Q1 <- data1 %>% 
  subset(ImportValue <= 5000000 & ExportValue <= 5000000)

Q2 <- data1 %>% 
  subset(ImportValue > 5000000 & ExportValue <= 5000000)

Q3 <- data1 %>% 
  subset(ImportValue > 5000000 & ExportValue > 5000000)

Q4 <- data1 %>% 
  subset(ImportValue <= 5000000 & ExportValue > 5000000)

Q4 %>%
  plot_ly(
    x = ~`ImportValue`,
    y = ~`ExportValue`,
    color = ~`Country`, 
    frame = ~year(`MonthYear`),
    text= ~paste("Country:",`Country`,
                 "\nImport Value:", `ImportValue`,
                 "\nExport Value:", `ExportValue`), 
    hoverinfo = "text",
    type = 'scatter',
    mode = 'markers'
  ) %>% 
  layout(title = list(text="Low Import - High Export"),
         hoverlabel = list(align = "left"),
         legend = list(orientation = "h", y = 1, x = 0),
         showlegend = FALSE,
         xaxis = list(title="Import Value", range = list(0, 5000000)),
         yaxis = list(title="Export Value", range = list(5000000, 10000000))
  ) %>% animation_opts(
    1000, easing = "linear", redraw = FALSE
  )
Q3 %>%
  plot_ly(
    x = ~`ImportValue`,
    y = ~`ExportValue`,
    color = ~`Country`, 
    frame = ~year(`MonthYear`),
    text= ~paste("Country:",`Country`,
                 "\nImport Value:", `ImportValue`,
                 "\nExport Value:", `ExportValue`), 
    hoverinfo = "text",
    type = 'scatter',
    mode = 'markers'
  ) %>% 
  layout(title = list(text="High Import - High Export"),
         hoverlabel = list(align = "left"),
         legend = list(orientation = "h", y = 1, x = 0),
         showlegend = FALSE,
         xaxis = list(title="Import Value", range = list(5000000, 10000000)),
         yaxis = list(title="Export Value", range = list(5000000, 10000000))
  ) %>% animation_opts(
    1000, easing = "linear", redraw = FALSE
  )
Q1 %>%
  plot_ly(
    x = ~`ImportValue`,
    y = ~`ExportValue`,
    color = ~`Country`, 
    frame = ~year(`MonthYear`),
    text= ~paste("Country:",`Country`,
                 "\nImport Value:", `ImportValue`,
                 "\nExport Value:", `ExportValue`), 
    hoverinfo = "text",
    type = 'scatter',
    mode = 'markers'
  ) %>% 
  layout(title = list(text="Low Import - Low Export"),
         hoverlabel = list(align = "left"),
         legend = list(orientation = "h", y = 1, x = 0),
         showlegend = FALSE,
         xaxis = list(title="Import Value", range = list(0, 5000000)),
         yaxis = list(title="Export Value", range = list(0, 5000000))
  ) %>% animation_opts(
    1000, easing = "linear", redraw = FALSE
  )
Q2 %>%
  plot_ly(
    x = ~`ImportValue`,
    y = ~`ExportValue`,
    color = ~`Country`, 
    frame = ~year(`MonthYear`),
    text= ~paste("Country:",`Country`,
                 "\nImport Value:", `ImportValue`,
                 "\nExport Value:", `ExportValue`), 
    hoverinfo = "text",
    type = 'scatter',
    mode = 'markers'
  ) %>% 
  layout(title = list(text="High Import - Low Export"),
         hoverlabel = list(align = "left"),
         legend = list(orientation = "h", y = 1, x = 0),
         showlegend = FALSE,
         xaxis = list(title="Import Value", range = list(5000000, 10000000)),
         yaxis = list(title="Export Value", range = list(0, 5000000))
  ) %>% animation_opts(
    1000, easing = "linear", redraw = FALSE
  )

# Prepare data for plotting
scatter <- data1 %>% 
  filter(Level=="Country")

# Building interactive filters
d <- highlight_key(scatter)

filter_tools <- htmltools::div(
  filter_slider(id = "period",
                label = "Select period",
                sharedData = d,
                column = ~MonthYear,
                dragRange = TRUE,
                step = 30,
                animate = TRUE,
                width = "100%",
                )
    )

# plotting interactive scatter plot using plotly
p <- plot_ly(data=d,
             x = ~`ImportValue`,
             y = ~`ExportValue`,
             type= "scatter",
             mode= "markers",
             color= ~`Country`,
             symbol = ~`Level`,
             colors = "Accent",
             marker= list(size=5, opacity = 0.5,
                          line=list(width=0.2, color="black")),
             text= ~paste("Country:",`Country`,
                          "\nImport Value:", `ImportValue`,
                          "\nExport Value:", `ExportValue`))

p <- p %>%
  layout(title = list(text="<b>Xxxxxxxxxxxxxxxx</b>"),
         hoverlabel = list(align = "left"),
         legend = list(orientation = "h", y = 1.5, x = 0),
         showlegend = FALSE,
         xaxis = list(title="Import Value", range = list(0, 10000000)),
         yaxis = list(title="Export Value", range = list(0, 10000000))
  ) 

p <- p %>%
  animation_opts(
    1000, easing = "elastic", redraw = FALSE
  )

gg <- highlight(p, "plotly_selected")

crosstalk::bscols(filter_tools,gg, widths = c(10, 12))

Select period

2.3 Interactive Dashboard

# Building interactive filters
scatter <- data1 %>% 
  filter(Level=="Country")

d <- highlight_key(data)

filter_tools <- htmltools::div(
  filter_select(id = "country", 
                  label = "Select Country", 
                  sharedData = d,
                  group = ~Country),
  filter_checkbox(id = "variable", 
                  label = "Select variable", 
                  sharedData = d,
                  group = ~Type,
                  inline = TRUE),
  filter_slider(id = "period", 
                label = "Select period", 
                sharedData = d, 
                column = ~MonthYear,
                width = "100%"))

bscols(
  d3scatter(data = scatter,
            x = ~`ImportValue`, 
            y = ~`ExportValue`, 
            color = ~`Country`, 
            # point_size = 50,
            # point_opacity = 0.5,
            # colors = "#A94175",
            width = "100%", 
            height = 500
            # fixed = FALSE,
            # xlim = c(0, 100000),
            # ylim = c(0, 200000),
            # xlab = "Import",
            # ylab = "Export",
            # axes_font_size = "100%",
            # lab = ~`Country`
            )
)

# # plotting interactive scatter plot using plotly
# p <- plot_ly(data=d,
#         type= "scatter",
#         mode= "markers",
#         x= ~lease_commence_date, 
#         y= ~resale_price,
#         color= ~storey,
#         colors= "Accent",
#         marker= list(size=5, opacity = 0.5,
#                      line=list(width=0.2, color="black")),
#         text= ~paste("Town:",town,
#                      "\nYear:",lease_commence_date,
#                      "\nLocation:",address,
#                      "\nType:",flat_type,
#                      "\nResale Price:",prettyNum(resale_price,big.mark=","),
#                      "\nStorey:",storey_range,
#                      "\nNearest MRT:",nearest_mrt," ~",nearest_distance_to_mrt,"km"
#                      )) %>% 
  # layout(title = list(text="<b>Xxxxxxxxxxxxxxxx</b>"),
  #        hoverlabel = list(align = "left"),
  #        legend = list(orientation = "h", y = 1, x = 0),
  #        xaxis = list(title="Lease Commencement Year"),
  #        yaxis = list(title="Resale Price (S$)"))

# gg <- highlight(p, "plotly_selected")


# Using crosstalk bscols to put all 3 elements (filter, scatter plot, datatable) together.
crosstalk::bscols(filter_tools,DT::datatable(d, class= "display",
                                                filter=list(position="top", clear=FALSE),
                                                options=list(pageLength = 10,scrollY = TRUE,
                                                             iDisplayLength = 25),
                                                ),
                  widths = c(3,12),
                  annotations = list(caption = "Data from Department of Statistics, Singapore (DOS)"))

Select Country

Select variable

ExportValue ImportValue

Select period

Data from Department of Statistics, Singapore (DOS)

# crosstalk::bscols(filter_tools,gg,DT::datatable(d, class= "display",
#                                                 filter=list(position="top", clear=FALSE),
#                                                 options=list(pageLength = 10,scrollY = TRUE,
#                                                              iDisplayLength = 25),
#                                                 ),
#                   widths = c(3,9,12),
#                   annotations = list(caption = "Data from Data.gov.sg"))

2.4 Cycle Plot

Step 1: Deriving month and year fields

# 
# Import$month <- month(Import$`MonthYear`)
# Import$year <- year(Import$`MonthYear`)

Step 2: Extracting the target country

# Australia <- Import %>% 
#   filter(`Country`== "  Australia (Thousand Dollars)")

Step 3: Computing year average arrivals by month

# hline.data <- Australia %>% 
#   group_by(month) %>%
#   summarise(avgvalue = mean(`Value`))

Step 4: Plotting the cycle plot ::: {#1 layout=“[1]”}

# ggplot() + 
#   geom_line(data=America,
#             aes(x=year, 
#                 y=`ImportValue`, 
#                 group=month), 
#             colour="black") +
#   geom_hline(aes(yintercept=avgvalue), 
#              data=hline.data, 
#              linetype=6, 
#              colour="red", 
#              linewidth=0.5) + 
#   facet_grid(~month) +
#   labs(axis.text.x = element_blank(),
#        title = "xxxxxxxxxxxxxxxxxxxxxxxxx") +
#   xlab("") +
#   ylab("Import Value") +
#   theme(plot.title = element_text(size=22),
#         axis.text.x = element_text(size = 10, angle = 90),
#         axis.text.y = element_text(size = 10),
#         strip.text = element_text(size = 10))

Pay Attention

Using callouts is an effective way to highlight content that your reader give special consideration or attention.